home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / device.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-04  |  24.7 KB  |  936 lines
  1. /* Generic device functions.
  2.    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois
  3.    Copyright (C) 1994, 1995 Amdahl Corporation
  4.  
  5. This file is part of XEmacs.
  6.  
  7. XEmacs is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with XEmacs; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. /* Synched up with: Not in FSF. */
  22.  
  23. /* Original version by Chuck Thompson;
  24.    rewritten by Ben Wing. */
  25.  
  26. #include <config.h>
  27. #include "lisp.h"
  28.  
  29. #include "buffer.h"
  30. #include "device.h"
  31. #include "elhash.h"
  32. #include "events.h"
  33. #include "faces.h"
  34. #include "frame.h"
  35. #include "keymap.h"
  36. #include "redisplay.h"
  37. #include "scrollbar.h"
  38. #include "specifier.h"
  39. #include "window.h"
  40.  
  41. #include "syssignal.h"
  42.  
  43. /* Vdefault_device is the firstly-created non-stream device that's still
  44.    around.  We don't really use it anywhere currently, but it might
  45.    be used for resourcing at some point.  (Currently we use
  46.    Vdefault_x_device.) */
  47. Lisp_Object Vdefault_device;
  48.  
  49. Lisp_Object Vdevice_list, Vselected_device;
  50.  
  51. Lisp_Object Vcreate_device_hook, Vdelete_device_hook;
  52.  
  53. /* Device classes */
  54. /* Qcolor defined in general.c */
  55. Lisp_Object Qgrayscale, Qmono;
  56.  
  57. Lisp_Object Qdevicep, Qdevice_live_p;
  58. Lisp_Object Qdelete_device;
  59. Lisp_Object Qcreate_device_hook;
  60. Lisp_Object Qdelete_device_hook;
  61.  
  62. DEFINE_DEVICE_TYPE (dead);
  63.  
  64. Lisp_Object Vdevice_class_list;
  65. Lisp_Object Vdevice_type_list;
  66.  
  67. MAC_DEFINE (struct device *, mactemp_device_data);
  68. MAC_DEFINE (struct device_methods *, mactemp_devtype_meth_or_given);
  69.  
  70. struct device_type_entry
  71. {
  72.   Lisp_Object symbol;
  73.   struct device_methods *meths;
  74. };
  75.  
  76. typedef struct device_type_entry_dynarr_type
  77. {
  78.   Dynarr_declare (struct device_type_entry);
  79. } device_type_entry_dynarr;
  80.  
  81. device_type_entry_dynarr *the_device_type_entry_dynarr;
  82.  
  83.  
  84.  
  85. static Lisp_Object mark_device (Lisp_Object, void (*) (Lisp_Object));
  86. static void print_device (Lisp_Object, Lisp_Object, int);
  87. DEFINE_LRECORD_IMPLEMENTATION ("device", device,
  88.                    mark_device, print_device, 0, 0, 0,
  89.                    struct device);
  90.  
  91. static Lisp_Object
  92. mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
  93. {
  94.   struct device *d = XDEVICE (obj);
  95.  
  96.   ((markobj) (d->name));
  97.   ((markobj) (d->selected_frame));
  98.   ((markobj) (d->frame_with_focus));
  99.   ((markobj) (d->frame_that_ought_to_have_focus));
  100.   ((markobj) (d->device_class));
  101.   ((markobj) (d->function_key_map));
  102.   ((markobj) (d->user_defined_tags));
  103.   ((markobj) (d->pixel_to_glyph_cache.obj));
  104.  
  105.   ((markobj) (d->color_instance_cache));
  106.   ((markobj) (d->font_instance_cache));
  107.   ((markobj) (d->image_instance_cache));
  108.  
  109.   if (d->methods)
  110.     ((markobj) (d->methods->symbol));
  111.   MAYBE_DEVMETH (d, mark_device, (d, markobj));
  112.  
  113.   return (d->frame_list);
  114. }
  115.  
  116. static void
  117. print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  118. {
  119.   struct device *d = XDEVICE (obj);
  120.   char buf[256];
  121.  
  122.   if (print_readably)
  123.     error ("printing unreadable object #<device %s 0x%x>",
  124.        string_data (XSTRING (d->name)), d->header.uid);
  125.  
  126.   sprintf (buf, "#<%s-device ", !DEVICE_LIVE_P (d) ? "dead" :
  127.        DEVICE_TYPE_NAME (d));
  128.   write_c_string (buf, printcharfun);
  129.   print_internal (DEVICE_NAME (d), printcharfun, 1);
  130.   sprintf (buf, " 0x%x>", d->header.uid);
  131.   write_c_string (buf, printcharfun);
  132. }
  133.  
  134.  
  135. int
  136. valid_device_class_p (Lisp_Object class)
  137. {
  138.   return !NILP (memq_no_quit (class, Vdevice_class_list));
  139. }
  140.  
  141. struct device_methods *
  142. decode_device_type (Lisp_Object type, int no_error)
  143. {
  144.   int i;
  145.  
  146.   for (i = 0; i < Dynarr_length (the_device_type_entry_dynarr); i++)
  147.     {
  148.       if (EQ (type, Dynarr_at (the_device_type_entry_dynarr, i).symbol))
  149.     return Dynarr_at (the_device_type_entry_dynarr, i).meths;
  150.     }
  151.  
  152.   if (!no_error)
  153.     signal_simple_error ("Invalid device type", type);
  154.  
  155.   return 0;
  156. }
  157.  
  158. int
  159. valid_device_type_p (Lisp_Object type)
  160. {
  161.   if (decode_device_type (type, 1))
  162.     return 1;
  163.   return 0;
  164. }
  165.  
  166. DEFUN ("valid-device-class-p", Fvalid_device_class_p, Svalid_device_class_p,
  167.        1, 1, 0,
  168.        "Given a DEVICE-CLASS, return t if it is valid.\n\
  169. Valid classes are 'color, 'grayscale, and 'mono.")
  170.      (device_class)
  171.      Lisp_Object device_class;
  172. {
  173.   if (valid_device_class_p (device_class))
  174.     return Qt;
  175.   else
  176.     return Qnil;
  177. }
  178.  
  179. DEFUN ("valid-device-type-p", Fvalid_device_type_p, Svalid_device_type_p,
  180.        1, 1, 0,
  181.        "Given a DEVICE-TYPE, return t if it is valid.\n\
  182. Valid types are 'x, 'tty, and 'stream.")
  183.      (device_type)
  184.      Lisp_Object device_type;
  185. {
  186.   if (valid_device_type_p (device_type))
  187.     return Qt;
  188.   else
  189.     return Qnil;
  190. }
  191.  
  192. DEFUN ("device-class-list", Fdevice_class_list, Sdevice_class_list,
  193.        0, 0, 0,
  194.        "Return a list of valid device classes.")
  195.      ()
  196. {
  197.   return Fcopy_sequence (Vdevice_class_list);
  198. }
  199.  
  200. DEFUN ("device-type-list", Fdevice_type_list, Sdevice_type_list,
  201.        0, 0, 0,
  202.        "Return a list of valid device types.")
  203.      ()
  204. {
  205.   return Fcopy_sequence (Vdevice_type_list);
  206. }
  207.  
  208. static struct device *
  209. allocate_device (void)
  210. {
  211.   Lisp_Object device = Qnil;
  212.   struct device *d = alloc_lcrecord (sizeof (struct device), lrecord_device);
  213.  
  214.   zero_lcrecord (d);
  215.   XSETDEVICE (device, d);
  216.  
  217.   d->name = Qnil;
  218.   d->frame_list = Qnil;
  219.   d->selected_frame = Qnil;
  220.   d->frame_with_focus = Qnil;
  221.   d->frame_that_ought_to_have_focus = Qnil;
  222.   d->device_class = Qnil;
  223.   d->function_key_map = Qnil;
  224.   d->user_defined_tags = Qnil;
  225.   d->pixel_to_glyph_cache.obj = Qnil;
  226.  
  227.   d->infd = d->outfd = -1;
  228.  
  229.   /* #### is 20 reasonable? */
  230.   d->color_instance_cache = make_lisp_hashtable (20, lisp_string_equal,
  231.                          lisp_string_hash,
  232.                          HASHTABLE_KEY_WEAK);
  233.   d->font_instance_cache = make_lisp_hashtable (20, lisp_string_equal,
  234.                         lisp_string_hash,
  235.                         HASHTABLE_KEY_WEAK);
  236.   /*
  237.      Note that the image instance cache is actually bi-level.
  238.      See device.h.  We use a low number here because most of the
  239.      time there aren't very many diferent masks that will be used.
  240.      */
  241.   d->image_instance_cache = make_lisp_hashtable (5, 0, 0,
  242.                          HASHTABLE_NONWEAK);
  243.  
  244.   d->quit_char = 7; /* C-g */
  245.  
  246.   return d;
  247. }
  248.  
  249. struct device *
  250. get_device (Lisp_Object device)
  251. {
  252.   if (NILP (device))
  253.     device = Fselected_device ();
  254.   /* quietly accept frames for the device arg */
  255.   if (FRAMEP (device))
  256.     {
  257.       CHECK_LIVE_FRAME (device, 0);
  258.       device = XFRAME (device)->device;
  259.     }
  260.   else
  261.     {
  262.       CHECK_LIVE_DEVICE (device, 0);
  263.     }
  264.   return XDEVICE (device);
  265. }
  266.  
  267. DEFUN ("dfw-device", Fdfw_device, Sdfw_device, 1, 1, 0,
  268.   "Given a device, frame, or window, return the associated device.\n\
  269. Return nil otherwise.")
  270.      (obj)
  271.      Lisp_Object obj;
  272. {
  273.   return DFW_DEVICE (obj);
  274. }
  275.  
  276.  
  277. DEFUN ("selected-device", Fselected_device, Sselected_device, 0, 0, 0,
  278.        "Return the device which is currently active.")
  279.      ()
  280. {
  281.   return Vselected_device;
  282. }
  283.  
  284. /* Called from selected_frame_1(), called from Fselect_window() */
  285. void
  286. select_device_1 (Lisp_Object device)
  287. {
  288.   /* perhaps this should do something more complicated */
  289.   Vselected_device = device;
  290.  
  291.   /* #### Schedule this to be removed in 19.14 */
  292. #ifdef HAVE_X_WINDOWS
  293.   if (DEVICE_IS_X (XDEVICE (device)))
  294.     Vwindow_system = Qx;
  295.   else
  296. #endif
  297. #ifdef HAVE_NEXTSTEP
  298.   if (DEVICE_IS_NS (XDEVICE (device)))
  299.     Vwindow_system = Qns;
  300.   else
  301. #endif
  302.     Vwindow_system = Qnil;
  303. }
  304.  
  305. DEFUN ("select-device", Fselect_device, Sselect_device, 1, 1, 0,
  306.   "Select the device DEVICE.\n\
  307. Subsequent editing commands apply to its selected frame and selected window.\n\
  308. The selection of DEVICE lasts until the next time the user does\n\
  309. something to select a different device, or until the next time this\n\
  310. function is called.")
  311.   (device)
  312.      Lisp_Object device;
  313. {
  314.   CHECK_LIVE_DEVICE (device, 0);
  315.  
  316.   /* select the device's selected frame's selected window.  This will call
  317.      selected_frame_1(). */
  318.   if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device))))
  319.     Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))));
  320.   else
  321.     error ("Can't select a device with no frames");
  322.   return Qnil;
  323. }
  324.  
  325. DEFUN ("devicep", Fdevicep, Sdevicep, 1, 1, 0,
  326.        "Return non-nil if OBJECT is a device.")
  327.      (object)
  328.      Lisp_Object object;
  329. {
  330.   if (!DEVICEP (object))
  331.     return Qnil;
  332.   return Qt;
  333. }
  334.  
  335. DEFUN ("device-live-p", Fdevice_live_p, Sdevice_live_p, 1, 1, 0,
  336.        "Return non-nil if OBJECT is a device that has not been deleted.")
  337.      (object)
  338.      Lisp_Object object;
  339. {
  340.   if (!DEVICEP (object) || !DEVICE_LIVE_P (XDEVICE (object)))
  341.     return Qnil;
  342.   return Qt;
  343. }
  344.  
  345. DEFUN ("device-type", Fdevice_type, Sdevice_type, 0, 1, 0,
  346.        "Return the type of the specified device (e.g. `x' or `tty').\n\
  347. Value is `tty' for a tty device (a character-only terminal),\n\
  348. `x' for a device which is a connection to an X server,\n\
  349. `stream' for a stream device (which acts like a stdio stream), and\n\
  350. `dead' for a deleted device.")
  351.      (device)
  352.      Lisp_Object device;
  353. {
  354.   /* don't call get_device() because we want to allow for dead devices. */
  355.   if (NILP (device))
  356.     device = Fselected_device ();
  357.   CHECK_DEVICE (device, 0);
  358.   return DEVICE_TYPE (XDEVICE (device));
  359. }
  360.  
  361. DEFUN ("device-name", Fdevice_name, Sdevice_name, 0, 1, 0,
  362.        "Return the name of the specified device.")
  363.      (device)
  364.      Lisp_Object device;
  365. {
  366.   return DEVICE_NAME (get_device (device));
  367. }
  368.  
  369. #ifdef HAVE_X_WINDOWS
  370. extern Lisp_Object Vdefault_x_device;
  371. #endif
  372. #ifdef HAVE_NEXTSTEP
  373. extern Lisp_Object Vdefault_ns_device;
  374. #endif
  375.  
  376. static void
  377. init_global_resources (struct device *d)
  378. {
  379.   init_global_faces (d);
  380.   init_global_scrollbars (d);
  381.   init_global_toolbars (d);
  382. }
  383.  
  384. static void
  385. init_device_resources (struct device *d)
  386. {
  387.   init_device_faces (d);
  388.   init_device_scrollbars (d);
  389.   init_device_toolbars (d);
  390. }
  391.  
  392. DEFUN ("make-device", Fmake_device, Smake_device, 1, 2, 0,
  393.        "Create a new device of type TYPE.\n\
  394. PARAMS, if specified, should be an alist of parameters controlling\n\
  395. device creation.")
  396.      (type, params)
  397.      Lisp_Object type, params;
  398. {
  399.   /* This function can GC */
  400.   struct device *d;
  401.   Lisp_Object device = Qnil;
  402.   struct gcpro gcpro1;
  403. #ifdef HAVE_X_WINDOWS
  404.   /* #### icky-poo.  If this is the first X device we are creating,
  405.      then retrieve the global face resources.  We have to do it
  406.      here, at the same time as (or just before) the device face
  407.      resources are retrieved; specifically, it needs to be done
  408.      after the device has been created but before any frames have
  409.      been popped up or much anything else has been done.  It's
  410.      possible for other devices to specify different global
  411.      resources (there's a property on each X server's root window
  412.      that holds some resources); tough luck for the moment.
  413.  
  414.      This is a nasty violation of device independence, but
  415.      there's not a whole lot I can figure out to do about it.
  416.      The real problem is that the concept of resources is not
  417.      generalized away from X.  Similar resource-related
  418.      device-independence violations occur in faces.el. */
  419.   int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
  420. #endif
  421.  
  422.   GCPRO1 (device);
  423.  
  424.   if (!valid_device_type_p (type))
  425.     signal_simple_error ("Invalid device type", type);
  426.  
  427.   d = allocate_device ();
  428.   XSETDEVICE (device, d);
  429.  
  430.   d->methods = decode_device_type (type, 0);
  431.  
  432.   DEVICE_NAME (d) = Fcdr_safe (Fassq (Qname, params));
  433.   DEVMETH (d, init_device, (d, params));
  434.  
  435.   /* Do it this way so that the device list is in order of creation */
  436.   Vdevice_list = nconc2 (Vdevice_list, Fcons (device, Qnil));
  437.   RESET_CHANGED_SET_FLAGS;
  438.   if (NILP (Vdefault_device) || DEVICE_IS_STREAM (XDEVICE (Vdefault_device)))
  439.     Vdefault_device = device;
  440.  
  441.   init_device_sound (d);
  442. #ifdef HAVE_X_WINDOWS
  443.   if (first_x_device)
  444.     init_global_resources (d);
  445. #endif
  446.   init_device_resources (d);
  447.  
  448.   if (DEVMETH (d, initially_selected_for_input, (d)))
  449.     event_stream_select_device (d);
  450.  
  451.   /* #### the following should trap errors.  However, if an error
  452.      occurs, all that will happen is that the create-device-hook
  453.      doesn't get run. */
  454.   setup_device_initial_specifier_tags (d);
  455.  
  456.   run_hook_with_args (Qcreate_device_hook, 1, device);
  457.  
  458.   UNGCPRO;
  459.   return device;
  460. }
  461.  
  462. void
  463. add_entry_to_device_type_list (Lisp_Object symbol,
  464.                    struct device_methods *meths)
  465. {
  466.   struct device_type_entry entry;
  467.  
  468.   entry.symbol = symbol;
  469.   entry.meths = meths;
  470.   Dynarr_add (the_device_type_entry_dynarr, entry);
  471.   Vdevice_type_list = Fcons (symbol, Vdevice_type_list);
  472. }
  473.  
  474. /* find a device other than the selected one.  Prefer non-stream
  475.    devices over stream devices. */
  476.  
  477. static Lisp_Object
  478. find_other_device (Lisp_Object device)
  479. {
  480.   Lisp_Object rest;
  481.  
  482.   /* look for a non-stream device */
  483.   DEVICE_LOOP (rest)
  484.     {
  485.       Lisp_Object dev = XCAR (rest);
  486.       if (!DEVICE_IS_STREAM (XDEVICE (dev)) && !EQ (dev, device) &&
  487.       !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
  488.     break;
  489.     }
  490.   if (!NILP (rest))
  491.     return XCAR (rest);
  492.  
  493.   /* OK, now look for a stream device */
  494.   DEVICE_LOOP (rest)
  495.     {
  496.       Lisp_Object dev = XCAR (rest);
  497.       if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
  498.     break;
  499.     }
  500.   if (!NILP (rest))
  501.     return XCAR (rest);
  502.  
  503.   /* Sorry, there ain't none */
  504.   return Qnil;
  505. }
  506.  
  507.  
  508. DEFUN ("delete-device", Fdelete_device, Sdelete_device, 1, 1, 0,
  509.        "Delete DEVICE, permanently eliminating it from use.")
  510.      (device)
  511.      Lisp_Object device;
  512. {
  513.   /* This function can GC */
  514.   Lisp_Object rest;
  515.   struct device *d;
  516.   int from_io_error = 0;
  517.  
  518.   /* kludge: if the device argument is a cons whose car is Qunbound,
  519.      we are being called as a result of an IO error on a device.
  520.      If this is the last device, don't try to ask for confirmation. */
  521.  
  522.   if (CONSP (device) && UNBOUNDP (XCAR (device)))
  523.     {
  524.       from_io_error = 1;
  525.       device = XCDR (device);
  526.     }
  527.  
  528.   CHECK_DEVICE (device, 0);
  529.   d = XDEVICE (device);
  530.  
  531.   /* OK to delete an already-deleted device. */
  532.   if (!DEVICE_LIVE_P (d))
  533.     return Qnil;
  534.  
  535.   /* If Vrun_hooks is nil, we are being called from shut_down_emacs().
  536.      At the time this is called, we could be in some weird unstable
  537.      state, so it's safest not to do most of the junk below.  We're
  538.      about to exit, so it doesn't matter anyway. */
  539.   if (!NILP (Vrun_hooks))
  540.     {
  541.       run_hook_with_args (Qdelete_device_hook, 1, device);
  542.     
  543.       if ((XINT (Flength (Vdevice_list)) == 1)
  544.       && !NILP (memq_no_quit (device, Vdevice_list)))
  545.         {
  546.       if (from_io_error)
  547.         {
  548.           /* Mayday mayday!  We're going down! */
  549.                 stderr_out ("  Autosaving and exiting...\n");
  550.                 Vwindow_system = Qnil; /* let it lie! */
  551.           Fset (Qkill_emacs_hook, Qnil); /* too dangerous */
  552.           Fkill_emacs (make_number (70));
  553.         }
  554.       else
  555.         call0 (Qsave_buffers_kill_emacs);
  556.     }
  557.  
  558.       for (rest = DEVICE_FRAME_LIST (d); !NILP (rest);
  559.        rest = XCDR (rest))
  560.     {
  561.       if (!FRAMEP (XCAR (rest)))
  562.         continue;
  563.       delete_frame_internal (XCAR (rest), 1);
  564.     }
  565.  
  566.       DEVICE_SELECTED_FRAME (d) = Qnil;
  567.  
  568.       /* try to select another device */
  569.  
  570.       if (EQ (device, Fselected_device ()))
  571.     {
  572.       Lisp_Object other_dev = find_other_device (device);
  573.       if (!NILP (other_dev))
  574.         Fselect_device (other_dev);
  575.       else
  576.         {
  577.           /* necessary? */
  578.           Vselected_device = Qnil;
  579.           Vwindow_system = Qnil;
  580.         }
  581.     }
  582.       
  583.       if (EQ (device, Vdefault_device))
  584.     Vdefault_device = find_other_device (device);
  585.     }
  586.       
  587.   if (d->input_enabled)
  588.     event_stream_unselect_device (d);
  589.   
  590.   DEVMETH (d, delete_device, (d));
  591.  
  592.   Vdevice_list = delq_no_quit (device, Vdevice_list);
  593.   RESET_CHANGED_SET_FLAGS;
  594.   d->methods = dead_device_methods;
  595.  
  596.   return Qnil;
  597. }
  598.  
  599. DEFUN ("device-list", Fdevice_list, Sdevice_list, 0, 0, 0,
  600.        "Return a list of all devices.")
  601.      ()
  602. {
  603.   return Fcopy_sequence (Vdevice_list);
  604. }
  605.  
  606. DEFUN ("device-frame-list", Fdevice_frame_list, Sdevice_frame_list,
  607.        0, 1, 0,
  608.        "Return a list of all frames on DEVICE.\n\
  609. If DEVICE is nil, the selected device will be used.")
  610.   (device)
  611.      Lisp_Object device;
  612. {
  613.   return Fcopy_sequence (DEVICE_FRAME_LIST (get_device (device)));
  614. }
  615.  
  616. DEFUN ("device-class", Fdevice_class, Sdevice_class,
  617.        0, 1, 0,
  618.        "Return the class (color behavior) of DEVICE.\n\
  619. This will be one of 'color, 'grayscale, or 'mono.")
  620.      (device)
  621.      Lisp_Object device;
  622. {
  623.   return DEVICE_CLASS (get_device (device));
  624. }
  625.  
  626. DEFUN ("device-pixel-width", Fdevice_pixel_width, Sdevice_pixel_width,
  627.        0, 1, 0,
  628.        "Return the width in pixels of DEVICE, or nil if unknown.")
  629.      (device)
  630.   Lisp_Object device;
  631. {
  632.   struct device *d = get_device (device);
  633.   int retval;
  634.  
  635.   retval = DEVMETH_OR_GIVEN (d, device_pixel_width, (d), 0);
  636.   if (retval <= 0)
  637.     return Qnil;
  638.  
  639.   return make_number (retval);
  640. }
  641.  
  642. DEFUN ("device-pixel-height", Fdevice_pixel_height, Sdevice_pixel_height,
  643.        0, 1, 0,
  644.        "Return the height in pixels of DEVICE, or nil if unknown.")
  645.      (device)
  646.   Lisp_Object device;
  647. {
  648.   struct device *d = get_device (device);
  649.   int retval;
  650.  
  651.   retval = DEVMETH_OR_GIVEN (d, device_pixel_height, (d), 0);
  652.   if (retval <= 0)
  653.     return Qnil;
  654.  
  655.   return make_number (retval);
  656. }
  657.  
  658. DEFUN ("device-mm-width", Fdevice_mm_width, Sdevice_mm_width,
  659.        0, 1, 0,
  660.        "Return the width in millimeters of DEVICE, or nil if unknown.")
  661.      (device)
  662.   Lisp_Object device;
  663. {
  664.   struct device *d = get_device (device);
  665.   int retval;
  666.  
  667.   retval = DEVMETH_OR_GIVEN (d, device_mm_width, (d), 0);
  668.   if (retval <= 0)
  669.     return Qnil;
  670.  
  671.   return make_number (retval);
  672. }
  673.  
  674. DEFUN ("device-mm-height", Fdevice_mm_height, Sdevice_mm_height,
  675.        0, 1, 0,
  676.        "Return the height in millimeters of DEVICE, or nil if unknown.")
  677.      (device)
  678.   Lisp_Object device;
  679. {
  680.   struct device *d = get_device (device);
  681.   int retval;
  682.  
  683.   retval = DEVMETH_OR_GIVEN (d, device_mm_height, (d), 0);
  684.   if (retval <= 0)
  685.     return Qnil;
  686.  
  687.   return make_number (retval);
  688. }
  689.  
  690. DEFUN ("device-bitplanes", Fdevice_bitplanes, Sdevice_bitplanes,
  691.        0, 1, 0,
  692.        "Return the number of bitplanes of DEVICE, or nil if unknown.")
  693.      (device)
  694.   Lisp_Object device;
  695. {
  696.   struct device *d = get_device (device);
  697.   int retval;
  698.  
  699.   retval = DEVMETH_OR_GIVEN (d, device_bitplanes, (d), 0);
  700.   if (retval <= 0)
  701.     return Qnil;
  702.  
  703.   return make_number (retval);
  704. }
  705.  
  706. DEFUN ("device-color-cells", Fdevice_color_cells, Sdevice_color_cells,
  707.        0, 1, 0,
  708.        "Return the number of color cells of DEVICE, or nil if unknown.")
  709.      (device)
  710.   Lisp_Object device;
  711. {
  712.   struct device *d = get_device (device);
  713.   int retval;
  714.  
  715.   retval = DEVMETH_OR_GIVEN (d, device_color_cells, (d), 0);
  716.   if (retval <= 0)
  717.     return Qnil;
  718.  
  719.   return make_number (retval);
  720. }
  721.  
  722. DEFUN ("set-device-baud-rate", Fset_device_baud_rate, Sset_device_baud_rate,
  723.        2, 2, 0,
  724.        "Set the output baud rate of DEVICE to RATE.\n\
  725. On most systems, changing this value will affect the amount of padding\n\
  726. and other strategic decisions made during redisplay.")
  727.      (device, rate)
  728.      Lisp_Object device, rate;
  729. {
  730.   CHECK_INT (rate, 0);
  731.  
  732.   DEVICE_BAUD_RATE (get_device (device)) = XINT (rate);
  733.  
  734.   return rate;
  735. }
  736.  
  737. DEFUN ("device-baud-rate", Fdevice_baud_rate, Sdevice_baud_rate,
  738.        0, 1, 0,
  739.        "Return the output baud rate of DEVICE.")
  740.      (device)
  741.      Lisp_Object device;
  742. {
  743.   return make_number (DEVICE_BAUD_RATE (get_device (device)));
  744. }
  745.  
  746. DEFUN ("device-enable-input", Fdevice_enable_input, Sdevice_enable_input,
  747.        1, 1, 0,
  748.   "Enable input on device DEVICE.")
  749.   (device)
  750.      Lisp_Object device;
  751. {
  752.   struct device *d = get_device (device);
  753.   if (!d->input_enabled)
  754.     event_stream_select_device (d);
  755.   return Qnil;
  756. }
  757.  
  758. DEFUN ("device-disable-input", Fdevice_disable_input, Sdevice_disable_input,
  759.        1, 1, 0,
  760.   "Disable input on device DEVICE.")
  761.   (device)
  762.      Lisp_Object device;
  763. {
  764.   struct device *d = get_device (device);
  765.   if (d->input_enabled)
  766.     event_stream_unselect_device (d);
  767.   return Qnil;
  768. }
  769.  
  770. /* #### These make a good case for adding at least some per-device
  771.    variables. */
  772. DEFUN ("device-function-key-map", Fdevice_function_key_map,
  773.        Sdevice_function_key_map, 0, 1, 0,
  774.   "Return the function key mapping for DEVICE.")
  775.   (device)
  776.      Lisp_Object device;
  777. {
  778.   return DEVICE_FUNCTION_KEY_MAP (get_device (device));
  779. }
  780.  
  781. DEFUN ("set-device-function-key-map", Fset_device_function_key_map,
  782.        Sset_device_function_key_map, 2, 2, 0,
  783.   "Set the function key mapping for DEVICE to KEYMAP.")
  784.   (device, keymap)
  785.      Lisp_Object device, keymap;
  786. {
  787.   struct device *d = get_device (device);
  788.  
  789.   CHECK_KEYMAP (keymap, 0);
  790.   d->function_key_map = keymap;
  791.   return keymap;
  792. }
  793.  
  794. void
  795. handle_asynch_device_change (void)
  796. {
  797.   int i;
  798.   int old_asynch_device_change_pending = asynch_device_change_pending;
  799.   for (i = 0; i < Dynarr_length (the_device_type_entry_dynarr); i++)
  800.     {
  801.       if (Dynarr_at (the_device_type_entry_dynarr, i).meths->
  802.       asynch_device_change_method)
  803.     (Dynarr_at (the_device_type_entry_dynarr, i).meths->
  804.      asynch_device_change_method) ();
  805.     }
  806.   /* reset the flag to 0 unless another notification occurred while
  807.      we were processing this one.  Block SIGWINCH during this
  808.      check to prevent a possible race condition. */
  809.   EMACS_BLOCK_SIGNAL (SIGWINCH);
  810.   if (old_asynch_device_change_pending == asynch_device_change_pending)
  811.     asynch_device_change_pending = 0;
  812.   EMACS_UNBLOCK_SIGNAL (SIGWINCH);
  813. }
  814.  
  815. void
  816. call_critical_lisp_code (struct device *d, Lisp_Object function,
  817.              Lisp_Object object)
  818. {
  819.   int old_gc_currently_forbidden = gc_currently_forbidden;
  820.   Lisp_Object old_inhibit_quit = Vinhibit_quit;
  821.  
  822.   /* There's no reason to bother doing specbinds here, because if
  823.      initialize-*-faces signals an error, emacs is going to crash
  824.      immediately.
  825.      */
  826.   gc_currently_forbidden = 1;
  827.   Vinhibit_quit = Qt;
  828.   LOCK_DEVICE (d);
  829.  
  830.   /* But it's useful to have an error handler; otherwise an infinite
  831.      loop may result. */
  832.   if (!NILP (object))
  833.     call1_with_handler (Qreally_early_error_handler, function, object);
  834.   else
  835.     call0_with_handler (Qreally_early_error_handler, function);
  836.       
  837.   UNLOCK_DEVICE (d);
  838.   Vinhibit_quit = old_inhibit_quit;
  839.   gc_currently_forbidden = old_gc_currently_forbidden;
  840. }
  841.  
  842.  
  843. /************************************************************************/
  844. /*                            initialization                            */
  845. /************************************************************************/
  846.  
  847. void
  848. syms_of_device (void)
  849. {
  850.   defsubr (&Svalid_device_class_p);
  851.   defsubr (&Svalid_device_type_p);
  852.   defsubr (&Sdevice_class_list);
  853.   defsubr (&Sdevice_type_list);
  854.  
  855.   defsubr (&Sdfw_device);
  856.   defsubr (&Sselected_device);
  857.   defsubr (&Sselect_device);
  858.   defsubr (&Sdevicep);
  859.   defsubr (&Sdevice_live_p);
  860.   defsubr (&Sdevice_type);
  861.   defsubr (&Sdevice_name);
  862.   defsubr (&Smake_device);
  863.   defsubr (&Sdelete_device);
  864.   defsubr (&Sdevice_list);
  865.   defsubr (&Sdevice_frame_list);
  866.   defsubr (&Sdevice_class);
  867.   defsubr (&Sdevice_pixel_width);
  868.   defsubr (&Sdevice_pixel_height);
  869.   defsubr (&Sdevice_mm_width);
  870.   defsubr (&Sdevice_mm_height);
  871.   defsubr (&Sdevice_bitplanes);
  872.   defsubr (&Sdevice_color_cells);
  873.   defsubr (&Sset_device_baud_rate);
  874.   defsubr (&Sdevice_baud_rate);
  875.   defsubr (&Sdevice_enable_input);
  876.   defsubr (&Sdevice_disable_input);
  877.   defsubr (&Sdevice_function_key_map);
  878.   defsubr (&Sset_device_function_key_map);
  879.  
  880.   defsymbol (&Qdevicep, "devicep");
  881.   defsymbol (&Qdevice_live_p, "device-live-p");
  882.   defsymbol (&Qdelete_device, "delete-device");
  883.  
  884.   defsymbol (&Qcreate_device_hook, "create-device-hook");
  885.   defsymbol (&Qdelete_device_hook, "delete-device-hook");
  886.  
  887.   /* Qcolor defined in general.c */
  888.   defsymbol (&Qgrayscale, "grayscale");
  889.   defsymbol (&Qmono, "mono");
  890. }
  891.  
  892. void
  893. device_type_create (void)
  894. {
  895.   the_device_type_entry_dynarr = Dynarr_new (struct device_type_entry);
  896.  
  897.   Vdevice_type_list = Qnil;
  898.   staticpro (&Vdevice_type_list);
  899.  
  900.   /* Initialize the dead device type */
  901.   INITIALIZE_DEVICE_TYPE (dead, "dead", "device-dead-p");
  902.  
  903.   /* then reset the device-type lists, because `dead' is not really
  904.      a valid device type */
  905.   Dynarr_reset (the_device_type_entry_dynarr);
  906.   Vdevice_type_list = Qnil;
  907. }
  908.  
  909. void
  910. vars_of_device (void)
  911. {
  912.   DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook,
  913.      "Function or functions to call when a device is created.\n\
  914. One argument, the newly-created device.\n\
  915. Note that the device will not be selected and will not have any\n\
  916. frames on it.");
  917.   Vcreate_device_hook = Qnil;
  918.  
  919.   DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook,
  920.      "Function or functions to call when a device is deleted.\n\
  921. One argument, the to-be-deleted device.");
  922.   Vdelete_device_hook = Qnil;
  923.  
  924.   staticpro (&Vdevice_list);
  925.   Vdevice_list = Qnil;
  926.   staticpro (&Vselected_device);
  927.   Vselected_device = Qnil;
  928.   staticpro (&Vdefault_device);
  929.   Vdefault_device = Qnil;
  930.  
  931.   asynch_device_change_pending = 0;
  932.  
  933.   Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
  934.   staticpro (&Vdevice_class_list);
  935. }
  936.